home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Jan / di9801kw / PropExp1.pas < prev    next >
Pascal/Delphi Source File  |  1997-07-29  |  19KB  |  602 lines
  1. unit PropExp1;
  2.  
  3. {
  4.   Property Explorer.
  5.  
  6.   Request form(s) to search and value to look for,
  7.   then display properties that have this name or value.
  8.  
  9.   Written by Keith Wood, 20 March 1997.
  10.   Version 1.0
  11. }
  12.  
  13. interface
  14.  
  15. uses
  16.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  17.   Forms, Dialogs, ToolIntf, StdCtrls, Buttons, ExtCtrls, Grids, EditIntf,
  18.   ComCtrls, Menus, ExptIntf;
  19.  
  20. type
  21.   { The dialog box that is the expert }
  22.   TfrmPropExplorerExpert = class(TForm)
  23.     Label1: TLabel;
  24.     Label2: TLabel;
  25.     lbxForms: TListBox;
  26.     btnLocate: TBitBtn;
  27.     btnCancel: TBitBtn;
  28.     hdrResults: THeader;
  29.     stgResults: TStringGrid;
  30.     Label3: TLabel;
  31.     cbxMatchCase: TCheckBox;
  32.     cbxWholeWords: TCheckBox;
  33.     btnAll: TButton;
  34.     btnNone: TButton;
  35.     btnShow: TBitBtn;
  36.     pnlStatus: TPanel;
  37.     ragSearchIn: TRadioGroup;
  38.     popAbout: TPopupMenu;
  39.     mni1: TMenuItem;
  40.     mni3: TMenuItem;
  41.     mni2: TMenuItem;
  42.     btnSave: TBitBtn;
  43.     dlgSave: TSaveDialog;
  44.     cmbValue: TComboBox;
  45.     procedure hdrResultsSizing(Sender: TObject; ASection, AWidth: Integer);
  46.     procedure lbxFormsClick(Sender: TObject);
  47.     procedure btnAllClick(Sender: TObject);
  48.     procedure btnNoneClick(Sender: TObject);
  49.     procedure EnableLocate(Sender: TObject);
  50.     procedure btnLocateClick(Sender: TObject);
  51.     procedure stgResultsEnter(Sender: TObject);
  52.     procedure stgResultsExit(Sender: TObject);
  53.     procedure stgResultsDblClick(Sender: TObject);
  54.     procedure btnShowClick(Sender: TObject);
  55.     procedure btnSaveClick(Sender: TObject);
  56.   private
  57.     { Private declarations }
  58.     procedure ProcessFiles(sMatchValue: String; lbxForms: TListBox);
  59.   public
  60.     { Public declarations }
  61.     constructor Create(AOwner: TComponent);
  62.   end;
  63.  
  64. { Interface procedure from Delphi }
  65. procedure PropExplorerExpert;
  66.  
  67. implementation
  68.  
  69. {$R *.DFM}
  70.  
  71. { TString -------------------------------------------------------------------- }
  72.  
  73. type
  74.   { Encapsulate a string in an object }
  75.   TString = class
  76.   private
  77.     FValue: String;
  78.   public
  79.     constructor Create(sValue: String);
  80.     property Value: String read FValue write FValue;
  81.   end;
  82.  
  83. { Create a new object with an embedded string }
  84. constructor TString.Create(sValue: String);
  85. begin
  86.   inherited Create;
  87.   FValue := sValue;
  88. end;
  89.  
  90. { TfrmPropExplorerExpert ----------------------------------------------------- }
  91.  
  92. const
  93.   cWhiteSpace: set of Char = [' ', #9];  { White space characters to ignore }
  94.   cSep = '|';                            { Separator character }
  95.   cCR = #13;                             { Carriage return }
  96.   iValues: set of Byte = [1, 2];         { Search in property value }
  97.   iProperties: set of Byte = [0, 2];     { Search in property name }
  98.   iMinWidth = 523;                       { Width of results grid without scrollbar }
  99.  
  100. { Create new expert dialog and find current file }
  101. constructor TfrmPropExplorerExpert.Create(AOwner: TComponent);
  102. var
  103.   i: Integer;
  104.   sProjectPath, sFilePath, sFileName: String;
  105.   slsModified: TStringList;
  106.   ediEditor: TIEditorInterface;
  107.   fmiForm: TIFormInterface;
  108. begin
  109.   inherited Create(AOwner);
  110.   { Display project name }
  111.   Caption := Caption + ' - ' + ExtractFileName(ToolServices.GetProjectName);
  112.   { Align results grid columns }
  113.   for i := 0 to hdrResults.Sections.Count - 1 do
  114.     stgResults.ColWidths[i] := hdrResults.SectionWidth[i] - 1;
  115.   { Create list for modified files }
  116.   slsModified := TStringList.Create;
  117.   try
  118.     sProjectPath := ExtractFilePath(ToolServices.GetProjectName);
  119.     { Load form names into listbox }
  120.     for i := 0 to ToolServices.GetFormCount - 1 do
  121.     begin
  122.       sFilePath := ExtractFilePath(ToolServices.GetFormName(i));
  123.       if sFilePath = sProjectPath then
  124.         sFilePath := ''
  125.       else
  126.         sFilePath := ' in ' + sFilePath;
  127.       lbxForms.Items.AddObject(ExtractFileName(ToolServices.GetFormName(i)) + sFilePath,
  128.         TString.Create(ToolServices.GetFormName(i)));
  129.       sFileName := ChangeFileExt(ToolServices.GetFormName(i), '.pas');
  130.       if ToolServices.IsFileOpen(sFileName) then  { Check if modified }
  131.         with ToolServices.GetModuleInterface(sFileName) do
  132.           try
  133.             ediEditor := GetEditorInterface;
  134.             fmiForm := GetFormInterface;
  135.             if ediEditor.BufferModified or fmiForm.FormModified then
  136.               slsModified.Add(sFileName);
  137.           finally
  138.             fmiForm.Free;
  139.             ediEditor.Free;
  140.             Free;
  141.           end;
  142.     end;
  143.     { If modified files have not been saved - ask for action }
  144.     if slsModified.Count > 0 then
  145.       case MessageDlg('Some files in this project have'#13#10 +
  146.           'been modified but not yet saved.'#13#10 +
  147.           'Save these files?', mtConfirmation, mbYesNoCancel, 0) of
  148.         mrYes:    for i := 0 to slsModified.Count - 1 do
  149.                     ToolServices.SaveFile(slsModified[i]);
  150.         mrNo:     { Ignore };
  151.         mrCancel: Abort;
  152.       end;
  153.   finally
  154.     slsModified.Free;
  155.   end;
  156.   { Highlight current form }
  157.   i := lbxForms.Items.IndexOf(ChangeFileExt(ExtractFileName(ToolServices.GetCurrentFile), '.dfm'));
  158.   if i > -1 then
  159.     lbxForms.Selected[i] := True
  160.   else if lbxForms.Items.Count = 1 then
  161.     lbxForms.Selected[0] := True;
  162. end;
  163.  
  164. { Resize string grid }
  165. procedure TfrmPropExplorerExpert.hdrResultsSizing(Sender: TObject; ASection, AWidth: Integer);
  166. var
  167.   i, iWidth: Integer;
  168. begin
  169.   stgResults.ColWidths[ASection] := AWidth - 1;
  170.   iWidth := 0;
  171.   for i := 0 to 2 do
  172.     Inc(iWidth, stgResults.ColWidths[i]);
  173.   stgResults.ColWidths[3] := iMinWidth - 6 - iWidth;
  174. end;
  175.  
  176. { Set all/none buttons appropriately }
  177. procedure TfrmPropExplorerExpert.lbxFormsClick(Sender: TObject);
  178. var
  179.   i: Integer;
  180. begin
  181.   btnAll.Enabled := False;
  182.   btnNone.Enabled := False;
  183.   with lbxForms do
  184.     for i := 0 to Items.Count - 1 do
  185.     begin
  186.       if not Selected[i] then
  187.         btnAll.Enabled := True;
  188.       if Selected[i] then
  189.         btnNone.Enabled := True;
  190.       if btnAll.Enabled and btnNone.Enabled then
  191.         Break;
  192.     end;
  193.   EnableLocate(Sender);
  194. end;
  195.  
  196. { Select all forms for searching }
  197. procedure TfrmPropExplorerExpert.btnAllClick(Sender: TObject);
  198. var
  199.   i: Integer;
  200. begin
  201.   for i := 0 to lbxForms.Items.Count - 1 do
  202.     lbxForms.Selected[i] := True;
  203.   lbxForms.TopIndex := 0;
  204.   lbxFormsClick(Sender);
  205.   ActiveControl := cmbValue;
  206. end;
  207.  
  208. { Clear all forms from searching }
  209. procedure TfrmPropExplorerExpert.btnNoneClick(Sender: TObject);
  210. var
  211.   i: Integer;
  212. begin
  213.   for i := 0 to lbxForms.Items.Count - 1 do
  214.     lbxForms.Selected[i] := False;
  215.   lbxForms.TopIndex := 0;
  216.   lbxFormsClick(Sender);
  217. end;
  218.  
  219. { Enable Locate button if applicable }
  220. procedure TfrmPropExplorerExpert.EnableLocate(Sender: TObject);
  221. begin
  222.   btnLocate.Enabled := ((cmbValue.Text <> '') and (lbxForms.SelCount > 0));
  223. end;
  224.  
  225. { Start processing }
  226. procedure TfrmPropExplorerExpert.btnLocateClick(Sender: TObject);
  227. begin
  228.   try
  229.     Screen.Cursor := crHourglass;
  230.     btnLocate.Enabled := False;
  231.     if cmbValue.Items.IndexOf(cmbValue.Text) = -1 then
  232.       cmbValue.Items.Add(cmbValue.Text);
  233.     ProcessFiles(cmbValue.Text, lbxForms);
  234.   finally
  235.     Screen.Cursor := crDefault;
  236.     btnLocate.Enabled := True;
  237.   end;
  238. end;
  239.  
  240. { Scan the file for the requested property name and/or value }
  241. procedure TfrmPropExplorerExpert.ProcessFiles(sMatchValue: String; lbxForms: TListBox);
  242. var
  243.   stmForm: TFileStream;                          { Input resource file }
  244.   stmMemory: TMemoryStream;                      { Converted to text }
  245.   sLine: String;                                 { Current line from file }
  246.   sProperty: String;                             { Current property - for lists }
  247.   sValue: String;                                { Value of current property }
  248.   slsTokens, slsObjects, slsCalls: TStringList;  { Working lists }
  249.   iForm, iSep1, iSep2, iSep3, iSep4: Integer;
  250.   bInList, bInCollection, bFound: Boolean;
  251.  
  252.   { Break line up into tokens - separated by white space }
  253.   procedure GetTokens;
  254.   var
  255.     iPos, iLen: Integer;
  256.     sToke